home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / ooptut34.zip / TP / OOPTUTOR / OOPTUTOR.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-24  |  17KB  |  593 lines
  1. {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
  2. {                                                                    }
  3. {   Tutor for Turbo Pascal Object-oriented Programming (version 6.0) }
  4. {   Based on the Borland Turbo Vision program TVDEMO.PAS found on    }
  5. {   the Install diskette.                                            }
  6. {                                                                    }
  7. {   Program using Turbo Vision to provide a menu screen for the      }
  8. {   selection of Turbo Pascal OOP notes and example programs.        }
  9. {                                                                    }
  10. {   OOPTUTOR.PAS  -> .EXE      R Shaw    Copyright   9.11.92         }
  11. {____________________________________________________________________}
  12.  
  13. program OOPTutor;
  14.  
  15. {$X+,S-}
  16. {$M 16384,8192,655360}
  17.  
  18. { This program uses many of the Turbo Vision standard and demo units,
  19.   including:
  20.  
  21.     StdDlg    - Open file browser, change directory tree.
  22.     MsgBox    - Simple dialog to display messages.
  23.     ColorSel  - Color customization.
  24.     Gadgets   - Shows system time and available heap space.
  25.     FViewer   - Scroll through text files.
  26.     HelpFile  - Context sensitive help.
  27.     MouseDlg  - Mouse options dialog.
  28.  
  29.   And of course this program includes many standard Turbo Vision
  30.   objects and behaviors (menubar, desktop, status line, dialog boxes,
  31.   mouse support, window resize/move/tile/cascade).
  32. }
  33.  
  34. uses
  35.   Dos, Objects, Drivers, Memory, Views, Menus, Dialogs, StdDlg, MsgBox, App,
  36.   DemoCmds, Gadgets, FViewer, HelpFile, OOPHelp, ColorSel, MouseDlg, Hexa,
  37.   Crt;
  38.  
  39. const
  40.   cmRecInit      = 110;   { These are demonstration programs by R Shaw    }
  41.   cmObjInit      = 111;   { for the Turbo Pascal OOP course.              }
  42.   cmWrongOop     = 112;
  43.   cmRightOop     = 113;
  44.   cmJuniorOb     = 114;
  45.   cmFigDemo      = 116;
  46.   cmListDemo     = 117;
  47.   cmStreams      = 118;
  48.   cmProgOpen     = 119;
  49.   cmLOpen        = 120;
  50.   cmCollect      = 121;
  51.   cmObCompat     = 122;
  52.  
  53. type
  54.  
  55.   { TTVDemo }
  56.  
  57.   PTVDemo = ^TTVDemo;
  58.   TTVDemo = object(TApplication)
  59.     Clock: PClockView;
  60.     Heap: PHeapView;
  61.     constructor Init;
  62.     procedure FileOpen(WildCard: PathStr);
  63.     procedure GetEvent(var Event: TEvent); virtual;
  64.     function GetPalette: PPalette; virtual;
  65.     procedure HandleEvent(var Event: TEvent); virtual;
  66.     procedure Idle; virtual;
  67.     procedure InitMenuBar; virtual;
  68.     procedure InitStatusLine; virtual;
  69.     procedure LoadDesktop(var S: TStream);
  70.     procedure OutOfMemory; virtual;
  71.     procedure StoreDesktop(var S: TStream);
  72.     procedure ViewFile(FileName: PathStr);
  73.   end;
  74.  
  75. { CalcHelpName }
  76.  
  77. function CalcHelpName: PathStr;
  78. var
  79.   EXEName: PathStr;
  80.   Dir: DirStr;
  81.   Name: NameStr;
  82.   Ext: ExtStr;
  83. begin
  84.   if Lo(DosVersion) >= 3 then EXEName := ParamStr(0)
  85.   else EXEName := FSearch('OOPTUTOR.EXE', GetEnv('PATH'));
  86.   FSplit(EXEName, Dir, Name, Ext);
  87.   if Dir[Length(Dir)] = '\' then Dec(Dir[0]);
  88.   CalcHelpName := FSearch('OOPHELP.HLP', Dir);
  89. end;
  90.  
  91.  
  92. { TTVDemo }
  93. constructor TTVDemo.Init;
  94. var
  95.   R: TRect;
  96.   I: Integer;
  97.   FileName: PathStr;
  98. begin
  99.   TApplication.Init;
  100.   RegisterObjects;
  101.   RegisterViews;
  102.   RegisterMenus;
  103.   RegisterDialogs;
  104.   RegisterApp;
  105.   RegisterHelpFile;
  106.   RegisterFViewer;
  107.  
  108.   GetExtent(R);
  109.   R.A.X := R.B.X - 9; R.B.Y := R.A.Y + 1;
  110.   Clock := New(PClockView, Init(R));
  111.   Insert(Clock);
  112.  
  113.   GetExtent(R);
  114.   Dec(R.B.X);
  115.   R.A.X := R.B.X - 9; R.A.Y := R.B.Y - 1;
  116.   Heap := New(PHeapView, Init(R));
  117.   Insert(Heap);
  118.  
  119.   for I := 1 to ParamCount do
  120.   begin
  121.     FileName := ParamStr(I);
  122.     if FileName[Length(FileName)] = '\' then
  123.       FileName := FileName + '*.*';
  124.     if (Pos('?', FileName) = 0) and (Pos('*', FileName) = 0) then
  125.       ViewFile(FExpand(FileName))
  126.     else FileOpen(FileName);
  127.   end;
  128. end;
  129.  
  130. procedure TTVDemo.FileOpen(WildCard: PathStr);
  131. var
  132.   D: PFileDialog;
  133.   FileName: PathStr;
  134. begin
  135.   D := New(PFileDialog, Init(WildCard, 'Open a File',
  136.     '~N~ame', fdOpenButton + fdHelpButton, 100));
  137.   D^.HelpCtx := hcFOFileOpenDBox;
  138.   if ValidView(D) <> nil then
  139.   begin
  140.     if Desktop^.ExecView(D) <> cmCancel then
  141.     begin
  142.       D^.GetFileName(FileName);
  143.       ViewFile(FileName);
  144.     end;
  145.     Dispose(D, Done);
  146.   end;
  147. end;
  148.  
  149. procedure TTVDemo.GetEvent(var Event: TEvent);
  150. var
  151.   W: PWindow;
  152.   HFile: PHelpFile;
  153.   HelpStrm: PDosStream;
  154. const
  155.   HelpInUse: Boolean = False;
  156. begin
  157.   TApplication.GetEvent(Event);
  158.   case Event.What of
  159.     evCommand:
  160.       if (Event.Command = cmHelp) and not HelpInUse then
  161.       begin
  162.         HelpInUse := True;
  163.         HelpStrm := New(PDosStream, Init(CalcHelpName, stOpenRead));
  164.         HFile := New(PHelpFile, Init(HelpStrm));
  165.         if HelpStrm^.Status <> stOk then
  166.         begin
  167.           MessageBox('Could not open help file.', nil, mfError + mfOkButton);
  168.           Dispose(HFile, Done);
  169.         end
  170.         else
  171.         begin
  172.           W := New(PHelpWindow,Init(HFile, GetHelpCtx));
  173.           if ValidView(W) <> nil then
  174.           begin
  175.             ExecView(W);
  176.             Dispose(W, Done);
  177.           end;
  178.           ClearEvent(Event);
  179.         end;
  180.         HelpInUse := False;
  181.       end;
  182.     evMouseDown:
  183.       if Event.Buttons <> 1 then Event.What := evNothing;
  184.   end;
  185. end;
  186.  
  187. function TTVDemo.GetPalette: PPalette;
  188. const
  189.   CNewColor = CColor + CHelpColor;
  190.   CNewBlackWhite = CBlackWhite + CHelpBlackWhite;
  191.   CNewMonochrome = CMonochrome + CHelpMonochrome;
  192.   P: array[apColor..apMonochrome] of string[Length(CNewColor)] =
  193.     (CNewColor, CNewBlackWhite, CNewMonochrome);
  194. begin
  195.   GetPalette := @P[AppPalette];
  196. end;
  197.  
  198. procedure TTVDemo.HandleEvent(var Event: TEvent);
  199.  
  200. procedure ChangeDir;
  201. var
  202.   D: PChDirDialog;
  203. begin
  204.   D := New(PChDirDialog, Init(cdNormal + cdHelpButton, 101));
  205.   D^.HelpCtx := hcFCChDirDBox;
  206.   if ValidView(D) <> nil then
  207.   begin
  208.     DeskTop^.ExecView(D);
  209.     Dispose(D, Done);
  210.   end;
  211. end;
  212.  
  213. procedure Tile;
  214. var
  215.   R: TRect;
  216. begin
  217.   Desktop^.GetExtent(R);
  218.   Desktop^.Tile(R);
  219. end;
  220.  
  221. procedure Cascade;
  222. var
  223.   R: TRect;
  224. begin
  225.   Desktop^.GetExtent(R);
  226.   Desktop^.Cascade(R);
  227. end;
  228.  
  229.  
  230. procedure About;
  231. var
  232.   D: PDialog;
  233.   Control: PView;
  234.   R: TRect;
  235. begin
  236.   R.Assign(0, 0, 60, 11);
  237.   D := New(PDialog, Init(R, 'About'));
  238.   with D^ do
  239.   begin
  240.     Options := Options or ofCentered;
  241.  
  242.     R.Grow(-1, -1);
  243.     Dec(R.B.Y, 3);
  244.     Insert(New(PStaticText, Init(R,
  245.       #13 +
  246.       ^C'Turbo Pascal OOP Tutor and Examples'#13 +
  247.       #13 +
  248.       ^C'R Shaw  Copyright  9.11.92'#13 +
  249.       #13 +
  250.       ^C'Based on a Turbo Vision program by Borland')));
  251.  
  252.     R.Assign(25, 8, 35, 10);
  253.     Insert(New(PButton, Init(R, 'O~K', cmOk, bfDefault)));
  254.   end;
  255.   if ValidView(D) <> nil then
  256.   begin
  257.     Desktop^.ExecView(D);
  258.     Dispose(D, Done);
  259.   end;
  260. end;
  261.  
  262. procedure Colors;
  263. var
  264.   D: PColorDialog;
  265. begin
  266.   D := New(PColorDialog, Init('',
  267.     ColorGroup('Desktop',
  268.       ColorItem('Color',             32, nil),
  269.     ColorGroup('Menus',
  270.       ColorItem('Normal',            2,
  271.       ColorItem('Disabled',          3,
  272.       ColorItem('Shortcut',          4,
  273.       ColorItem('Selected',          5,
  274.       ColorItem('Selected disabled', 6,
  275.       ColorItem('Shortcut selected', 7, nil)))))),
  276.     ColorGroup('Dialogs/Calc',
  277.       ColorItem('Frame/background',  33,
  278.       ColorItem('Frame icons',       34,
  279.       ColorItem('Scroll bar page',   35,
  280.       ColorItem('Scroll bar icons',  36,
  281.       ColorItem('Static text',       37,
  282.  
  283.       ColorItem('Label normal',      38,
  284.       ColorItem('Label selected',    39,
  285.       ColorItem('Label shortcut',    40,
  286.  
  287.       ColorItem('Button normal',     41,
  288.       ColorItem('Button default',    42,
  289.       ColorItem('Button selected',   43,
  290.       ColorItem('Button disabled',   44,
  291.       ColorItem('Button shortcut',   45,
  292.       ColorItem('Button shadow',     46,
  293.  
  294.       ColorItem('Cluster normal',    47,
  295.       ColorItem('Cluster selected',  48,
  296.       ColorItem('Cluster shortcut',  49,
  297.  
  298.       ColorItem('Input normal',      50,
  299.       ColorItem('Input selected',    51,
  300.       Col